home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / mxlibs / dwstk102 / playdwd.pas < prev    next >
Pascal/Delphi Source File  |  1995-04-12  |  6KB  |  246 lines
  1. (******************************************************************************
  2. File:                          playdwd.pas 1.02
  3. Tab stops:                 every 2 columns
  4. Project:                     DWD Player
  5. Copyright:                 1994-1995 DiamondWare, Ltd.    All rights reserved.
  6. Written:                     Keith Weiner & Erik Lorenzen
  7. Pascal Conversion: David A. Johndrow
  8. Purpose:                     Contains simple example code to show how to load/play a
  9.                                      .DWD file
  10. History:                     94/10/21 KW Started playdwd.c
  11.                                      94/11/12 DJ Translated to Pascal
  12.                                      95/01/12 EL Finalized
  13.                                      95/03/22 EL Finalized for 1.01
  14.                                      95/04/11 EL Finalized for 1.02
  15.  
  16. Notes
  17. -----
  18. This code isn't really robust when it comes to standard error checking
  19. and particularly recovery, software engineering technique, etc.  A buffer
  20. is statically allocated.    A better technique would be to use fstat() or stat()
  21. to determine the file's size then malloc(size).  The STK will handle songs
  22. larger than 64K (but not digitized sounds).  Obviously, you'd need to fread()
  23. such a file in chunks, or write some sort of hfread() (huge fread).  Also,
  24. exitting and cleanup is not handled robustly in this code.    The code below can
  25. only be validated by extremely careful scrutiny to make sure each case is
  26. handled properly.  A better method would the use of C's atexit function.
  27.  
  28. But all such code would make this example file less clear; its purpose was
  29. to illustrate how to call the STK, not how to write QA-proof software.
  30. ******************************************************************************)
  31.  
  32.  
  33.  
  34. Program PlayDWD;
  35.  
  36. uses crt, err, dws;
  37.  
  38.  
  39.  
  40. var
  41.     ExitSave: pointer;
  42.  
  43.     ch:                 char;
  44.     fp:                 file;
  45.     dov:                dws_DOPTR;
  46.     dres:             dws_DRPTR;
  47.     ideal:            dws_IDPTR;
  48.     dplay:            dws_DPPTR;
  49.     errno:            word;
  50.     input:            integer;
  51.     sound:            pointer;
  52.     result:         word;
  53.     soundsize:    longint;
  54.     DWDInitted: boolean;
  55.     KeepGoing:    boolean;
  56.  
  57.  
  58. Function Exist(FileName: string): boolean;
  59. Var
  60.     Fil: File;
  61.  
  62. begin
  63.     Assign(Fil,FileName);
  64.     {*$I- }
  65.     Reset(Fil);
  66.     Close(Fil);
  67.     {$I+ }
  68.  
  69.     Exist := (IOResult = 0);
  70. end;
  71.  
  72.  
  73.  
  74. procedure ExitPlay; far;
  75.  
  76. label TRYTOKILLAGAIN;
  77.  
  78. begin
  79.     ExitProc := ExitSave;
  80.  
  81. TRYTOKILLAGAIN:
  82.  
  83.     if (dws_Kill <> 1) then
  84.     begin
  85.         (*
  86.          . If an error occurs here, it's either dws_Kill_CANTUNHOOKISR
  87.          . or dws_NOTINITTED.  If it's dws_Kill_CANTUNHOOKISR the user
  88.          . must remove his tsr, and dws_Kill must be called again.    If it's
  89.          . dws_NOTINITTED, there's nothing to worry about at this point.
  90.         *)
  91.         err_Display;
  92.  
  93.         if (dws_ErrNo = dws_Kill_CANTUNHOOKISR) then
  94.         begin
  95.             goto TryToKillAgain;
  96.         end;
  97.     end;
  98.  
  99.     if (sound <> nil) then
  100.     begin
  101.         freemem(sound, soundsize);
  102.     end;
  103.  
  104.     dispose(dplay);
  105.     dispose(ideal);
  106.     dispose(dres);
  107.     dispose(dov);
  108. end;
  109.  
  110.  
  111.  
  112. begin
  113.     ExitSave := ExitProc;
  114.     ExitProc := @ExitPlay;
  115.  
  116.     writeln;
  117.     writeln('PLAYDWD 1.02 is Copyright 1994-95, DiamondWare, Ltd.');
  118.     writeln('All rights reserved.');
  119.     writeln;
  120.     writeln;
  121.  
  122.     new(dov);
  123.     new(dres);
  124.     new(ideal);
  125.     new(dplay);
  126.  
  127.     sound := nil;
  128.  
  129.     if (ParamCount = 0) then
  130.     begin
  131.         writeln('Usage PLAYDWD <dwd-file>');
  132.         halt(65535);
  133.     end;
  134.  
  135.     if Exist(ParamStr(1)) then
  136.     begin
  137.         Assign(fp, ParamStr(1));
  138.         Reset(fp,1);
  139.         soundsize := filesize(fp);
  140.  
  141.         (* Please note we don't check to see if we get the memory we need. *)
  142.         Getmem(sound, soundsize);
  143.         BlockRead(fp,sound^,soundsize);
  144.         Close(fp);
  145.     end
  146.     else
  147.     begin
  148.         writeln('Unable to open '+ParamStr(1));
  149.         halt(65535);
  150.     end;
  151.  
  152.     (*
  153.      . We need to set every field to -1 in dws_DETECTOVERRIDES record; this
  154.      . tells the STK to autodetect everything.    Any other value
  155.      . overrides the autodetect routine, and will be accepted on
  156.      . faith, though the STK will verify it if possible.
  157.     *)
  158.     dov^.baseport := 65535;
  159.     dov^.digdma     := 65535;
  160.     dov^.digirq     := 65535;
  161.  
  162.     if (dws_DetectHardWare(dov, dres) = 0) then
  163.     begin
  164.         err_Display;
  165.         halt(65535);
  166.     end;
  167.  
  168.     if ((dres^.capability and dws_capability_DIG) <> dws_capability_DIG) then
  169.     begin
  170.         if ((dres^.baseport <> 904) and (dres^.baseport <> 65535)) then
  171.         begin
  172.             writeln('The sound hardware supports digitized sound playback,');
  173.             writeln('but we could not find the DMA channel and/or IRQ level.');
  174.         end
  175.         else
  176.         begin
  177.             writeln('Support for digitized playback not found.');
  178.         end;
  179.  
  180.         halt(65535);
  181.     end;
  182.  
  183.  
  184.     (*
  185.      . The "ideal" record tells the STK how you'd like it to initialize the
  186.      . sound hardware.    In all cases, if the hardware won't support your
  187.      . request, the STK will go as close as possible.  For example, not all
  188.      . sound boards will support al sampling rates (some only support 5 or
  189.      . 6 discrete rates).
  190.     *)
  191.     ideal^.musictyp     := 0;         (*0=No music, 1=OPL2*)
  192.     ideal^.digtyp         := 8;         (*0=No Dig, 8=8bit*)
  193.     ideal^.digrate        := 11000; (*sampling rate, in Hz*)
  194.                                                             (*we could have called dws_DGetRateFromDWD*)
  195.                                                             (*before dws_Init to get the correct rate*)
  196.     ideal^.dignvoices := 1;         (*number of voices (up to 16)*)
  197.     ideal^.dignchan     := 1;         (*1=mono*)
  198.  
  199.     if (dws_Init(dres, ideal) = 0) then
  200.     begin
  201.         err_Display;
  202.         halt(65535);
  203.     end;
  204.  
  205.     (* Set master volume to about 80% max *)
  206.     if (dws_XMaster(200) = 0) then
  207.     begin
  208.         err_Display;
  209.     end;
  210.  
  211.     dplay^.snd            := sound;
  212.     dplay^.count        := 1;             (* 0=infinite loop, 1-N num times to play sound *)
  213.     dplay^.priority := 1000;
  214.     dplay^.presnd     := 0;
  215.  
  216.     if (dws_DGetRateFromDWD(sound, @ideal^.digrate) = 0) then
  217.     begin
  218.         err_Display;
  219.         halt(65535);
  220.     end;
  221.  
  222.     if (dws_DSetRate(ideal^.digrate) = 0) then
  223.     begin
  224.         err_Display;
  225.         halt(65535);
  226.     end;
  227.  
  228.     if (dws_DPlay(dplay) = 0) then
  229.     begin
  230.         err_Display;
  231.         halt(65535);
  232.     end;
  233.  
  234.     repeat
  235.     begin
  236.         if(dws_DSoundStatus(dplay^.soundnum, @result) = 0) then
  237.         begin
  238.             err_Display;
  239.             halt(65535);
  240.         end;
  241.     end;
  242.     until (result = 0) or (keypressed);
  243.  
  244.     halt(65535);
  245. end.
  246.